home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacMETH 3.2.1 / More Examples / Hennessy2.MOD < prev    next >
Encoding:
Text File  |  1992-10-09  |  2.4 KB  |  122 lines  |  [TEXT/MEDT]
  1. MODULE Hennessy2;
  2.  
  3. FROM Storage IMPORT ALLOCATE;
  4. FROM SYSTEM IMPORT VAL, TSIZE;
  5. FROM SYSTEM IMPORT REG, SETREG;
  6. FROM InOut IMPORT WriteLn, WriteString, WriteInt, Read, OpenOutput, CloseOutput;
  7.  
  8. CONST
  9.     intmmbase = 1.46;
  10.     rowsize = 40;
  11.  
  12. TYPE
  13.     (* Intmm, Mm *)
  14.     index = [0 .. rowsize];
  15.     intmatrix = ARRAY index, index OF LONGINT;
  16.  
  17.     Proc = PROCEDURE;
  18.  
  19. VAR
  20.     fixed,floated: REAL; ch: CHAR;
  21.  
  22.     (* global *)
  23.     seed: LONGINT;
  24.  
  25.     (* Intmm, Mm *)
  26.     ima, imb, imr: intmatrix;
  27.  
  28. (* global procedures *)
  29.  
  30. PROCEDURE Getclock (): LONGINT;
  31.     TYPE P = POINTER TO LONGINT;
  32.     VAR ticks: P; tk: LONGINT;
  33. BEGIN    ticks := VAL(P, 16AH);
  34.     tk := ticks^; RETURN TRUNCD(FLOATD(tk) * (1000.0D0/60.0D0) + 0.5D0)
  35. END Getclock;
  36.  
  37. PROCEDURE Initrand ();
  38. BEGIN seed := 74755D
  39. END Initrand;
  40.  
  41. PROCEDURE Rand (): LONGINT;
  42. BEGIN
  43.     seed := (seed * 1309D + 13849D) MOD 65535D;
  44.     RETURN (seed);
  45. END Rand;
  46.  
  47.     (* Multiplies two integer matrices. *)
  48.  
  49.     PROCEDURE Initmatrix (VAR m: intmatrix);
  50.         VAR temp, i, j: LONGINT;
  51.     BEGIN i := 1D;
  52.         WHILE i <= LONG(rowsize) DO
  53.             j := 1D;
  54.             WHILE j <= LONG(rowsize) DO
  55.                 temp := Rand();
  56.                 m[i][j] := temp - (temp DIV 120D)*120D - 60D;
  57.                 INC(j)
  58.             END ;
  59.             INC(i)
  60.         END
  61.     END Initmatrix;
  62.  
  63.     PROCEDURE Innerproduct(VAR result: LONGINT; VAR a,b: intmatrix; row,column: LONGINT);
  64.         VAR i: LONGINT;
  65.   (* computes the inner product of A[row,*] and B[*,column] *)
  66.     BEGIN
  67.         result := 0; i := 1;
  68.         WHILE i <= LONG(rowsize) DO result := result+a[row][i]*b[i][column]; INC(i) END
  69.     END Innerproduct;
  70.  
  71. PROCEDURE Intmm ();
  72.     VAR i, j: LONGINT;
  73. BEGIN
  74.     Initrand();
  75.     Initmatrix (ima);
  76.     Initmatrix (imb);
  77.     i := 1D;
  78.     WHILE i <= LONG(rowsize) DO j := 1D;
  79.         WHILE j <= LONG(rowsize) DO Innerproduct(imr[i][j],ima,imb,i,j); INC(j) END ;
  80.         INC(i)
  81.     END
  82. END Intmm;
  83.  
  84.  
  85.  
  86. PROCEDURE Time(s: ARRAY OF CHAR; p: Proc; base, fbase: REAL);
  87.     VAR timer: LONGINT;
  88. BEGIN
  89.     timer := Getclock();
  90.     p;
  91.     timer := Getclock()-timer;
  92.     WriteString(s);
  93.     WriteInt(SHORT(timer), 8); WriteLn;
  94.     fixed := fixed + FLOAT(timer)*base;
  95.     floated := floated + FLOAT(timer)*fbase
  96. END Time;
  97.  
  98. PROCEDURE main2(i: INTEGER);
  99. BEGIN
  100.     fixed := 0.0;  floated := 0.0;
  101.     Time("Intmm  ", Intmm, intmmbase, intmmbase);
  102. END main2;
  103.  
  104. PROCEDURE main;
  105. BEGIN
  106.     fixed := 0.0;  floated := 0.0;
  107.     Time("Intmm  ", Intmm, intmmbase, intmmbase);
  108.     WriteLn;
  109.     main2(19);
  110. END main;
  111.  
  112. BEGIN
  113.  OpenOutput("H2.Mac");
  114.  WriteString("Hennessy2 mit MacMETH 3.2 : "); WriteLn;
  115.  WriteLn;
  116.     main;
  117.  CloseOutput;
  118.  WriteLn;
  119.  WriteString("any key to terminate. "); WriteLn;
  120.  Read(ch);
  121. END Hennessy2.
  122.